perm filename 4RAW16.SAI[BIG,HPM]1 blob
sn#143682 filedate 1975-02-05 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00003 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 BEGIN "NTONIC"
C00005 00003 PROCEDURE M4WAY(INTEGER FIRST INTEGER ARRAY NEXT)
C00010 ENDMK
C⊗;
BEGIN "NTONIC"
REQUIRE "DDSUB.SAI[GRA,HPM]" SOURCE_FILE;
REQUIRE "PRANDR.SAI[BIG,HPM]" SOURCE_FILE;
DEFINE NEL=4, N=4, NOPEN=4;
INTEGER DONE,FOO,I,J,K,L;
STRING S; BOOLEAN MERGE,PASS;
INTEGER ARRAY WIRE[0:N-1,0:NEL-1],STATE[0:N-1,0:NEL-1],NSET[0:NEL-1];
INTEGER ARRAY NEXT,PERM,OUTPUT,INPUTMAP[0:N*NOPEN-1];
PROCEDURE FOLLOW;
BEGIN
INTEGER I,J,K,L;
DONE←0;
WHILE DONE<NEL DO FOR I←0 STEP 1 UNTIL NEL-1 DO IF NSET[I]=N THEN
BEGIN
FOR J←1 STEP 1 UNTIL N-1 DO FOR K←0 STEP 1 UNTIL J-1 DO
IF STATE[J,I]<STATE[K,I] THEN STATE[J,I]↔STATE[K,I];
FOR J←0 STEP 1 UNTIL N-1 DO
BEGIN
K←WIRE[J,I];
IF K≥0 THEN
BEGIN
L←NSET[K];
NSET[K]←L+1;
STATE[L,K]←STATE[J,I];
END
ELSE
OUTPUT[-1-K]←STATE[J,I];
END;
NSET[I]←-N;
DONE←DONE+1;
END;
END;
PROCEDURE DRAW;
BEGIN
REAL ARRAY X,Y[0:NEL-1];
INTEGER I,J,K;
PROCEDURE SET(INTEGER L; REAL XV,YV);
BEGIN X[L]←XV; Y[L]←YV; END;
SET(0,1,1);
SET(1,1,2);
SET(2,1,3);
SET(3,1,4);
DDINIT;
SCREEN(-1,-.1,6,6);
DRKEN; RECTAN(-100,-100,100,100); LITEN;
FOR I←0 STEP 1 UNTIL NEL-1 DO RECTAN(X[I]-.1,Y[I]-.2,X[I]+.2,Y[I]+.2);
FOR I←0 STEP 1 UNTIL N*NOPEN-1 DO
LINE(0,I*5/15,X[INPUTMAP[I]],Y[INPUTMAP[I]]);
FOR I←0 STEP 1 UNTIL NEL-1 DO
FOR J←0 STEP 1 UNTIL N-1 DO
BEGIN REAL FX,FY;
FX←X[I]+.2; FY←Y[I]+(J/(N-1)-.5)*.4;
IF WIRE[J,I]<0 THEN LINE(FX,FY,4,(-1-WIRE[J,I])*5/15)
ELSE LINE(FX,FY,X[WIRE[J,I]],Y[WIRE[J,I]]);
END;
FOR I←1,2,3 DO DPYUP('36);
SHOW('36);
END;
PROCEDURE M4WAY(INTEGER FIRST; INTEGER ARRAY NEXT);
BEGIN
INTEGER I,J;
FOR I←0 STEP 1 UNTIL N-1 DO FOR J←0 STEP 1 UNTIL N-1 DO
WIRE[J,I+FIRST]←NEXT[J+4*I];
END;
FOR J←0 STEP 1 UNTIL 15 DO INPUTMAP[J]←J MOD 4;
OUTSTR("INPUTMAP ");
FOR I←0 STEP 1 UNTIL N*NOPEN-1 DO OUTSTR(CVS(INPUTMAP[I])&" "); OUTSTR('15&'12);
FOR I←0 STEP 1 UNTIL N*NOPEN-1 DO NEXT[I]←-1-I;
M4WAY(0,NEXT);
DRAW;
OUTSTR('12&"WIRES "&'15&'12);
FOR J←0 STEP 1 UNTIL N-1 DO
BEGIN
FOR I←0 STEP 1 UNTIL NEL-1 DO OUTSTR(CVS(WIRE[J,I])&" ");
OUTSTR('15&'12);
END;
OUTSTR('15&'12&'12);
BEGIN
INTEGER ARRAY CNTR[1:N*NOPEN];
INTEGER ARRAY CHECK[0:N*NOPEN,0:N*NOPEN];
FOR I←1 STEP 1 UNTIL N*NOPEN DO CNTR[I]←(N*NOPEN-I)%NOPEN;
MERGE←TRUE;
DO
BEGIN
K←-1;
FOR I←N-1 STEP -1 UNTIL 0 DO FOR J←1 STEP 1 UNTIL N*NOPEN DO
IF CNTR[J]=I THEN PERM[K←K+1]←J;
FOR I←0 STEP 1 UNTIL NEL-1 DO NSET[I]←0;
FOR I←0 STEP 1 UNTIL N*NOPEN-1 DO
BEGIN
K←INPUTMAP[I];
L←NSET[K];
NSET[K]←L+1;
STATE[L,K]←PERM[I];
END;
FOLLOW;
PASS←FALSE;
FOR K←0 STEP 1 UNTIL N*NOPEN-1 DO
BEGIN
L←0; WHILE CHECK[K,L]≠0∧CHECK[K,L]<OUTPUT[K] DO L←L+1;
IF CHECK[K,L]≠OUTPUT[K] THEN
BEGIN
WHILE OUTPUT[K]≠0 DO
BEGIN
CHECK[K,L]↔OUTPUT[K];
L←L+1;
END;
PASS←TRUE;
END;
END;
IF PASS THEN
BEGIN
DRKEN; RECTAN(4.01,-100,100,100); LITEN;
FOR K←0 STEP 1 UNTIL N*NOPEN-1 DO
BEGIN
TXTPOS(4.01,(N*NOPEN-1-K-.5)*5/15,.1,.2);
L←0; WHILE CHECK[K,L]≠0 DO TEXT('77+CHECK[K,(L←L+1)-1]);
END;
DPYUP('36);
END;
PWITHR(CNTR,N*NOPEN,MERGE);
END UNTIL MERGE;
END;
END;